VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsPhoneEntries"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'*---------------------------------------------------------------
'*
'* ClassName:      clsPhoneEntries
'* FileName:       PhoneEntries.CLS
'* Date:           July 1998
'* Author:         Ian M. Weatherburn
'* Company:        Mindkey Software Solutions (Pty) Ltd.
'* Copyright:      Copyright (C) 1998 by Mindkey Software Solutions
'*                 All Rights Reserved
'* Description:    RAS Phone Entry Collection
'*
'*---------------------------------------------------------------

Option Explicit

' PhoneEntry object count
Private intPCount As Integer
Private Sub Class_initialize()
  Dim lngSuccess As Long
  
  ' Initialise Phone book collection
  lngSuccess = fnRASEnumEntries()
End Sub

Public Property Get Count() As Integer
  Dim lngRetCode
  
  lngRetCode = fnRASEnumEntries()
  If lngRetCode Then
    Err.Raise vbObjectError + lngRetCode, _
              "PhoneEntries.Count Failure", _
              "RAS Failure"
  Else
    Count = intPCount
  End If
End Property

Public Sub AddEntry()
  Dim lngRetCode As Long
  
  lngRetCode = RasCreatePhonebookEntry(APINULL, "")
  
  If lngRetCode Then
    lngRASErrorNumber = lngRetCode
    strRASErrorMessage = lpRASError.fnRASErrorMessage()
    Err.Raise vbObjectError + lngRetCode, _
              "PhoneEntries AddEntry Failed", _
              "RAS Failure"
  Else
    lngRetCode = fnRASEnumEntries()
    If lngRetCode Then
      Err.Raise vbObjectError + lngRetCode, _
                "PhoneEntries AddEntry Failed", _
                "RAS Failure"
    End If
  End If
End Sub

Private Function fnRASEnumEntries() As Long

  Dim lngRetCode As Long
  Dim lpszReserved As String
  Dim lpszPhonebook As String
  Dim lpcb As Long
  Dim lpcEntries As Long
  Dim intArraySize As Integer
  Dim intLoop As Long
  
  lpszReserved = vbNullString
  lpszPhonebook = vbNullString
  
  ' Allocating space for a maximum of 256 entries.
  ' If it fails we resize later
  intArraySize = 256
  
  If lngWindowVersion = VER_PLATFORM_WIN32_NT Then
    ' We are running under Windows NT
    ReDim lpRASEntryName(intArraySize) As RASEntryName
    lpRASEntryName(0).dwSize = 28
    lpcb = 256 & lpRASEntryName(0).dwSize
    lngRetCode = RasEnumEntries(lpszReserved, _
                                lpszPhonebook, _
                                lpRASEntryName(0), _
                                lpcb, _
                                lpcEntries)
  Else
    ' We are running under Windows 95
    ReDim lpRASEntryName95(intArraySize) As RASEntryName95
    lpRASEntryName95(0).dwSize = 264
    lpcb = 256 * lpRASEntryName95(0).dwSize
    lngRetCode = RasEnumEntries(lpszReserved, _
                                lpszPhonebook, _
                                lpRASEntryName95(0), _
                                lpcb, _
                                lpcEntries)
  End If
  
  Select Case lngRetCode
    Case RAS_SUCCESS
      If lpcEntries > 0 Then
        ' Resize array so that is the correct size based
        ' on the number of entries returned from the function
        ReDim arrPEntry(lpcEntries - 1) As clsPhoneEntry
        If lngWindowVersion = VER_PLATFORM_WIN32_NT Then
          ' We are running under Windows NT
          For intLoop = 0 To UBound(arrPEntry())
            Set arrPEntry(intLoop) = New clsPhoneEntry
            blnAllowUpdate = True
            arrPEntry(intLoop).EntryName = _
              fnTrimNulls(StrConv(lpRASEntryName(intLoop).szEntryName, vbUnicode))
            arrPEntry(intLoop).Index = intLoop
            blnAllowUpdate = False
          Next intLoop
        Else
          ' We are running under Windows 95
          For intLoop = 0 To UBound(arrPEntry())
            Set arrPEntry(intLoop) = New clsPhoneEntry
            blnAllowUpdate = True
            arrPEntry(intLoop).EntryName = _
              fnTrimNulls(StrConv(lpRASEntryName95(intLoop).szEntryName, vbUnicode))
            arrPEntry(intLoop).Index = intLoop
            blnAllowUpdate = False
          Next intLoop
        End If
      End If
      
      intPCount = CInt(lpcEntries)
      fnRASEnumEntries = 0
      
    Case ERROR_BUFFER_TOO_SMALL
      ' Make the buffers bigger and try again
      If lngWindowVersion = VER_PLATFORM_WIN32_NT Then
        ' We are running under Windows NT
        intArraySize = lpcb / lpRASEntryName(0).dwSize
      Else
        ' We are running under Windows 95
        intArraySize = lpcb / lpRASEntryName95(0).dwSize
      End If
    
    Case Else
      lngRASErrorNumber = lngRetCode
      strRASErrorMessage = lpRASError.fnRASErrorMessage()
      fnRASEnumEntries = lngRetCode
  End Select

End Function

'*---------------------------------------------------------------
'* EOF: clsPhoneEntries
'*---------------------------------------------------------------

